Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d20/wnode21.arc/WNODE.PAS

Pascal/Delphi Source File | 1992-01-15 | 22KB | 680 lines

Unit WNode;
{$O+;$R-;F+}

{****************************************************************************}
{      Window nodelist handler for editors,mailers and mail processors       }
{         Copyright 1991 by Silvan Calarco (2:334/[e-mail])         }
{****************************************************************************}

{****************************************************************************}
{ This unit may be used in your programs and is distributed to favour the    }
{ diffusion of an unique nodelist format. The nodelist compiler program is   }
{ called WNODE.EXE and is availaible either in the packed that contains      }
{ this unit and in SDS network.                                              }
{ The structures of W-Nodelist are in file WNSTRUCT.DOC.                     }
{                                                                            }
{ HOW TO USE THIS UNIT ------------------------------------------------------}
{                                                                            }
{ First thing to do is initializing nodelist files by calling:               }
{                                                                            }
{ Function InitNodeList(DirName:String):Boolean;                             }
{                                                                            }
{ Where DirName is the full path of the directory containing *.WNL files.    }
{ This function returns false if one of nodelist files is missing.           }
{                                                                            }
{ Using W-Nodelist two sort of shearches can be made:                        }
{ 1) By Sysop's name with FindFirstSysop and FindNextSysop                   }
{ 2) By Node number with FindFirstNode and FindNextNode                      }
{                                                                            }
{ Before performing any sort of search, you have to declare a variable       }
{ of type FindNodeRec. The filosophy of this method is very similar to       }
{ the one used by TP's FindFirst/FindNext procedures, so FindNodeRec has     }
{ the same purpose of SearchRec in unit DOS of TP.                           }
{ Inquire results will be returned in FindNodeRec.BBSRecord, a record        }
{ which contains these informations:                                         }
{                                                                            }
{ BBSRecord=Record                                                           }
{              NodeType:Byte;                                                }
{              Zone,Net,Node,Point:Integer;                                  }
{              BBSName:String[30];                                           }
{              SysopName:String[30];                                         }
{              Location:String[30];                                          }
{              Phone:String[18];                                             }
{              BaudRate:Word;                                                }
{              Flags:String[30];                                             }
{           end;                                                             }
{                                                                            }
{ NODETYPE contains one of the following values:                             }
{                                                                            }
{  ZC=1; REGION=2; HOST=4; HUB=8; PVT=16; INHOLD=32; DOWN=64; BOSS=128       }
{                                                                            }
{ Other fields contents are the image of what appears in nodelist.           }
{                                                                            }
{----------------------------------------------------------------------------}
{                                                                            }
{ 1) FindFirstSysop/FindNextSysop                                            }
{                                                                            }
{ To look for one or more entries knowing sysop's name call first time:      }
{                                                                            }
{ Procedure FindFirstSysop(SubStr:String;Var Find:FindNodeRec);              }
{                                                                            }
{ Where SubStr is the case unsensitive match string for sysop's name.        }
{ Note that a name like "John Mc Gregor" is converted in "GREGOR MC JOHN"    }
{ for search. This means that match string "MC GREGOR" wouldn't return       }
{ the desired entry.                                                         }
{                                                                            }
{ To continue search use:                                                    }
{                                                                            }
{ Procedure FindNextSysop(Var Find:FindNodeRec);                             }
{                                                                            }
{ If Find.BBSRecord.SysopName='' it means that there are no more entries.    }
{                                                                            }
{----------------------------------------------------------------------------}
{                                                                            }
{ 2) FindFirstNode/FindNextNode                                              }
{                                                                            }
{ To look for one or more entries knowing address call first time:           }
{                                                                            }
{ Procedure FindFirstNode(Zone,Net,Node,Point:Integer;Var Find:FindNodeRec); }
{                                                                            }
{ Where Zone,Net,Node,Point contain the address of the node to look for.     }
{ If you want to look for more than one entry, you can assign one of address }
{ fields the value of "ALL" constant. E.g.:                                  }
{                                                                            }
{ Zone:=ALL                      looks for every node in database            }
{ Zone:=2; Net:=334; Node:=ALL   looks for every node in zone 2, net 334     }
{                                                                            }
{ To continue search use:                                                    }
{                                                                            }
{ Procedure FindNextSysop(Var Find:FindNodeRec);                             }
{                                                                            }
{ If Find.BBSRecord.SysopName='' it means that there are no more entries.    }
{                                                                            }
{ You you don't want many files to be open at same time, you can call:       }
{                                                                            }
{ Procedure CloseNodeListFiles;                                              }
{                                                                            }
{ after any search. FindFirstNode/FindFirstSysop will open them again if     }
{ they are closed.                                                           }
{                                                                            }
{****************************************************************************}


Interface
Const
   { List of kinds of entryes specified in BBSRecord.NodeType }
   ZC=1;
   REGION=2;
   HOST=4;
   HUB=8;
   PVT=16;
   INHOLD=32;
   DOWN=64;
   BOSS=128;
   ALL=-1; { Used to select global nodes with FindFirstNode }

Type
   BBSRec=Record                 { Record containing nodelist informations }
             NodeType:Byte;
             Zone,Net,Node,Point:Integer;
             BBSName:String[30];
             SysopName:String[30];
             Location:String[30];
             Phone:String[18];
             BaudRate:Word;
             Flags:String[30];
          end;

   NodeLocRec=Record             { Record of NODELOC.WNL }
                 NodeType:Byte;
                 Zone,Net,Node,Point:Integer;
                 FileNum:Byte;
                 FilePos:Longint;
              end;
   SysopRec=Record               { Record of SYSLIST.WNL }
               Name:String[20];
               BBSRecord:Longint;
            end;
   NodeRec=Record                { Record of NODEIDX.WNL }
              NodeType:Byte;
              Number:Integer;
              BBSRecord:Longint;
              Match:Array[1..4] of Char;
              SysopRecord:Longint;
           end;

   FindNodeRec=Record            { Used by FindFirstNode/FindFirstSysop }
                  BBSRecord:BBSRec;
                  SZone,SNet,SNode,SPoint:Integer;
                  SysStr:String[30];
                  FPos,FPos1:Longint;
               end;

Var
   NodeLocFile:File of NodeLocRec;
   SysopListFile:File of SysopRec;
   NodeIdxFile:File of NodeRec;
   Nodelist1,NodeList2:File;
   NodeTime:Longint;

Function InitNodeList(DirName:String):Boolean; { True=Ok }
Procedure CloseNodeListFiles;
Procedure FindFirstSysop(SubStr:String;Var Find:FindNodeRec);
Procedure FindNextSysop(Var Find:FindNodeRec);
Procedure FindFirstNode(Zone,Net,Node,Point:Integer;Var Find:FindNodeRec);
Procedure FindNextNode(Var Find:FindNodeRec);
Procedure Split_Address(Address:String;Var Zone,Net,Node,Point:Integer);
                                { Splits a string-typed address into four    }
                                { numbers indicating Zone,Net,Node and Point }
Function Word_Upcase(Frase:String):String;
                                { Converts a string into its upper-case }
                                { correspondent                         }

Implementation
Uses
   Dos;

Function FileExists(Nome_Del_File:String):Boolean;
Var
   TestFile:File;

Begin
   Assign(TestFile,Nome_Del_File);
   {$I-}
   Reset(TestFile);
   {$I+}
   If IOResult=0 then
   Begin
      FileExists:=True;
      Close(TestFile);
   end
   else
      FileExists:=False;
end;

Function Val2(St:String):Longint;
Var
   Res:Longint;
   Err:Integer;

Begin
   Val(St,Res,Err);
   Val2:=Res;
end;

Function Word_Upcase(Frase:String):String;
Var
   Kunta:Integer;

Begin
   For Kunta:=1 to Length(Frase) do
      Frase[Kunta]:=UpCase(Frase[Kunta]);
   Word_UpCase:=Frase;
end;

Function CmpSort(Stringa1,Stringa2:String):Byte;
Var
   Pos:Byte;
   Exit:Byte;

Begin
   Pos:=1;
   Exit:=0;
   While (Pos<=Length(Stringa1)) and (Pos<=Length(Stringa2))
         and (Exit=0) do
   Begin
      If Stringa1[Pos]<Stringa2[Pos] then
         Exit:=1
      else
      If Stringa1[Pos]>Stringa2[Pos] then
         Exit:=2;
      Inc(Pos);
   end;
   If Exit=0 then
   Begin
      If Length(Stringa1)<Length(Stringa2) then
         Exit:=1
      else
      If Length(Stringa1)>Length(Stringa2) then
         Exit:=2
      else
         Exit:=3;
   end;
   CmpSort:=Exit;
end;

Function Convert_Name(FromStr:String):String; { Converts 'Silvan Calarco' into }
                                              { 'CALARCO SILVAN'               }

Var
   ResStr:String;
   Cont:Byte;

Begin
   ResStr:='';
   FromStr:=Word_UpCase(FromStr)+' ';
   While Length(FromStr)>0 do
   Begin
      Insert(Copy(FromStr,1,Pos(' ',FromStr)),ResStr,1);
      Delete(FromStr,1,Pos(' ',FromStr));
   end;
   ResStr[0]:=Chr(Length(ResStr)-1);
   For Cont:=2 to Length(ResStr) do
      If (ResStr[Cont] in ['A'..'Z']) and (ResStr[Cont-1]<>#32) then
          ResStr[Cont]:=Chr(Ord(ResStr[Cont])+32);
   Convert_Name:=ResStr;
end;

Function ReadVar(Var Linea:String):String;
Var
   C:Byte;

Begin
   C:=1;
   While (Linea[C]<>',') and (C<=Length(Linea)) do
   Begin
      If Linea[C]='_' then
         Linea[C]:=' ';
      Inc(C);
   end;
   If Pos(',',Linea)=0 then
   Begin
      ReadVar:=Copy(Linea,1,Pos(#13,Linea)-1);
      Linea:='';
   end
   else
   Begin
      ReadVar:=Copy(Linea,1,Pos(',',Linea)-1);
      Delete(Linea,1,Pos(',',Linea));
   end;
end;

Procedure Split_Address(Address:String;Var Zone,Net,Node,Point:Integer);
Var
   MomStr:String[5];

Begin
   Address:=Word_UpCase(Address);
   If Copy(Address,1,3)='ALL' then
   Begin
      Zone:=-1;Net:=-1;Node:=-1;Point:=-1;
   end
   else
   Begin
      Address:=Address+' ';
      Zone:=Val2(Copy(Address,1,Pos(':',Address)-1));
      If Zone=0 then
         Zone:=2;
      Delete(Address,1,Pos(':',Address));
      If copy(Address,1,3)='ALL' then
      Begin
         Net:=-1;
         Node:=-1;
         Point:=-1;
      end
      else
      Begin
         If Pos('/',Address)<>0 then
            Net:=Val2(Copy(Address,1,Pos('/',Address)-1));
         Delete(Address,1,Pos('/',Address));
         If Pos('.',Address)<>0 then
         Begin
            Node:=Val2(Copy(Address,1,Pos('.',Address)-1));
            If Address[1]='.' then
            Begin
               Net:=0;
               Node:=0;
            end;
            Delete(Address,1,Pos('.',Address));
            Point:=Val2(Copy(Address,1,Pos(' ',Address)-1));
         end
         else
         Begin
            MomStr:=Copy(Address,1,Pos(' ',Address)-1);
            If MomStr='ALL' then
               Node:=-1
            else
               Node:=Val2(MomStr);
            Point:=0;
         end
      end
   end
end;

Function TrovaTipo(Sub:String):Byte;
Begin
   If Sub='' then
      TrovaTipo:=0
   else
   If Sub='ZONE' then
      TrovaTipo:=ZC
   else
   If Sub='REGION' then
      TrovaTipo:=Region
   else
   If Sub='HOST' then
      TrovaTipo:=Host
   else
   If Sub='HUB' then
      TrovaTipo:=Hub
   else
   If Sub='PVT' then
      TrovaTipo:=Pvt
   else
   If Sub='HOLD' then
      TrovaTipo:=InHold
   else
   If Sub='DOWN' then
      TrovaTipo:=Down
   else
   If Sub='BOSS' then
      TrovaTipo:=Boss;
end;

Procedure RicavaRecord(Var St:String;Var BBSRecord:BBSRec;CurrZone,CurrNet,CurrNode:Integer);
Var
   Sub:String;
   Err:Integer;

Begin
   FillChar(BBSRecord,SizeOf(BBSRecord),#0);
   With BBSRecord do
   Begin
      Sub:=Word_UpCase(ReadVar(St));
      NodeType:=TrovaTipo(Sub);
      Sub:=ReadVar(St);
      If NodeType=ZC then
      Begin
         CurrZone:=Val2(Sub);
         CurrNet:=0;
         CurrNode:=-1;
      end
      else
      If NodeType in [Region,Host] then
      Begin
         CurrNet:=Val2(Sub);
         CurrNode:=-1;
      end
      else
      If NodeType=Boss then
      Begin
         Delete(Sub,Pos(#13,Sub),1);
         Split_Address(Sub,CurrZone,CurrNet,CurrNode,Err)
      end
      else
      Begin
         If CurrNode=-1 then
            Node:=Val2(Sub)
         else
         Begin
            Node:=CurrNode;
            Point:=Val2(Sub);
         end;
      end;
      Zone:=CurrZone;
      Net:=CurrNet;
      If NodeType<>Boss then
      Begin
         BBSName:=ReadVar(St);
         Location:=ReadVar(St);
         SysopName:=ReadVar(St);
         Phone:=ReadVar(St);
         BaudRate:=Val2(ReadVar(St));
         Flags:=Copy(St,1,Pos(#13,St)-1);
      end
      else
         Node:=CurrNode;
   end;
end;

Procedure FindRecord(NodoRec:NodeLocRec;Var ToRec:BBSRec);
Var
   Letti:Word;
   Linea:String;

Begin
   Case NodoRec.FileNum of
      1:If FileRec(Nodelist1).Mode=FMClosed then
           Reset(Nodelist1,1);
      2:If FileRec(Nodelist2).Mode=FMClosed then
           Reset(Nodelist2,1);
   end;
   Case NodoRec.FileNum of
      1:Begin
           Seek(Nodelist1,NodoRec.FilePos);
           BlockRead(Nodelist1,Linea[1],255,Letti);
           Linea[0]:=Chr(Letti);
        end;
      2:Begin
           Seek(Nodelist2,NodoRec.FilePos);
           BlockRead(Nodelist2,Linea[1],255,Letti);
           Linea[0]:=Chr(Letti);
        end;
   end;
   RicavaRecord(Linea,ToRec,0,0,-1);
   ToRec.Zone:=NodoRec.Zone;
   ToRec.Net:=NodoRec.Net;
   ToRec.Node:=NodoRec.Node;
   ToRec.Point:=NodoRec.Point;
end;

Function ConfrNode(Zona1,Net1,Nodo1,Point1,Zona2,Net2,Nodo2,Point2:Integer):Boolean;
Begin
   If (Zona1=ALL) or
      ((Zona1=Zona2) and (Net1=ALL)) or
      ((Zona1=Zona2) and (Net1=Net2) and (Nodo1=ALL)) or
      ((Zona1=Zona2) and (Net1=Net2) and (Nodo1=Nodo2) and (Point1=ALL)) or
      ((Zona1=Zona2) and (Net1=Net2) and (Nodo1=Nodo2) and (Point1=Point2)) then
         ConfrNode:=True
      else
         ConfrNode:=False;
end;

Procedure FindNextNodeIndex(Var Find:FindNodeRec);
Const
   ActZone:Integer=-1;
   ActNet:Integer=-1;

Var
   Nodelist:NodeRec;
   ActPos:Longint;
   Esci:Boolean;

Begin
   Seek(NodeIdxFile,Find.FPos1);
   Repeat
      Read(NodeIdxFile,Nodelist);
      ActPos:=Nodelist.BBSRecord;
      If Nodelist.NodeType=ZC then
      Begin
         ActZone:=Nodelist.Number;
         ActNet:=0;
      end
      else
      If Nodelist.NodeType in [Region,Host,Boss] then
         ActNet:=Nodelist.Number;
      Esci:=(ConfrNode(Find.SZone,Find.SNet,0,0,ActZone,ActNet,0,0));
   Until Esci or Eof(NodeIdxFile);
   Find.FPos1:=FilePos(NodeIdxFile);
   If not(Esci) then
      ActPos:=-1;
   Find.FPos:=ActPos;
end;

Procedure FindNextSysop(Var Find:FindNodeRec);
Var
   SysopList:SysopRec;
   NodeLoc:NodeLocRec;

Begin
   Seek(SysopListFile,Find.FPos);
   SysopList.Name:='';
   While not(Eof(SysopListFile)) and
         (CmpSort(Find.SysStr,SysopList.Name) in [2,3]) do
   Begin
      Read(SysopListFile,SysopList);
      If (Pos(Find.SysStr,SysopList.Name)=1) then
      Begin
         Seek(NodeLocFile,SysopList.BBSRecord);
         Read(NodeLocFile,NodeLoc);
         FindRecord(NodeLoc,Find.BBSRecord);
         Find.FPos:=FilePos(SysopListFile);
         Exit;
      end
   end;
   Find.BBSRecord.SysopName:='';
end;

Procedure FindNextNode(Var Find:FindNodeRec);
Var
   BBSList:NodeLocRec;

Begin
   Seek(NodeLocFile,Find.FPos);
   While not(Eof(NodeLocFile)) and (Find.FPos<>-1) do
   Begin
      Read(NodeLocFile,BBSList);
      If ConfrNode(Find.SZone,Find.SNet,Find.SNode,Find.SPoint,
                   BBSList.Zone,BBSList.Net,BBSList.Node,BBSList.Point) and
         (BBSList.NodeType<>Boss) then
      Begin
         FindRecord(BBSList,Find.BBSRecord);
         Find.FPos:=FilePos(NodeLocFile);
         Exit;
      end;
      If not(ConfrNode(Find.SZone,Find.SNet,0,0,BBSList.Zone,BBSList.Net,0,0)) then
      Begin
         FindNextNodeIndex(Find);
         If Find.FPos<>-1 then
            Seek(NodeLocFile,Find.Fpos);
      end;
   end;
   Find.BBSRecord.SysopName:='';
end;

Procedure FindFirstSysop(SubStr:String;Var Find:FindNodeRec);
Var
   NodeIdx:NodeRec;
   ActRec:Longint;
   ExtrStr:String[4];

Begin
   Find.SysStr:=Word_UpCase(Convert_Name(SubStr));
   ExtrStr:=Copy(Find.SysStr,1,4);
   Find.BBSRecord.SysopName:='';
   Find.FPos:=0;
   If FileRec(NodeLocFile).Mode=FMClosed then
      Reset(NodeLocFile);
   If FileRec(SysopListFile).Mode=FMClosed then
      Reset(SysopListFile);
   If FileRec(NodeIdxFile).Mode=FMClosed then
      Reset(NodeIdxFile);
   Seek(NodeIdxFile,0);
   NodeIdx.SysopRecord:=0;
   Repeat
      ActRec:=NodeIdx.SysopRecord;
      Read(NodeIdxFile,NodeIdx);
   Until (CmpSort(ExtrStr,NodeIdx.Match) in [1,3]) or
         Eof(NodeIdxFile);
   Find.FPos:=ActRec;
   FindNextSysop(Find);
end;

Procedure FindFirstNode(Zone,Net,Node,Point:Integer;Var Find:FindNodeRec);
Begin
   Find.SZone:=Zone;
   Find.SNet:=Net;
   Find.SNode:=Node;
   Find.SPoint:=Point;
   Find.BBSRecord.SysopName:='';
   If FileRec(NodeLocFile).Mode=FMClosed then
      Reset(NodeLocFile);
   If FileRec(SysopListFile).Mode=FMClosed then
      Reset(SysopListFile);
   If FileRec(NodeIdxFile).Mode=FMClosed then
      Reset(NodeIdxFile);
   Find.FPos1:=0;
   FindNextNodeIndex(Find);
   FindNextNode(Find);
end;

Function Trova_File_Recente(Dir:String;Var Check:Boolean):String;
Var
   S:SearchRec;
   ActTime:Longint;
   ActFile:String[12];
   Num,Err:Word;

Begin
   ActTime:=0;
   ActFile:='';
   S.Name:='';
   FindFirst(Dir,Archive,S);
   While S.Name<>'' do
   Begin
      Err:=0;
      If Check then
         Val(Copy(S.Name,Pos('.',S.Name)+1,3),Num,Err);
      If (S.Time>ActTime) and (Err=0) then
      Begin
         ActTime:=S.Time;
         ActFile:=S.Name;
      end;
      S.Name:='';
      FindNext(S);
   end;
   If (ActTime<NodeTime) and (NodeTime*ActTime<>0) then
      Check:=True
   else
      Check:=False;
   If ActFile='' then
      Dir:=''
   else
   While (Dir[Length(Dir)]<>'\') and (Length(Dir)>0) do
      Delete(Dir,Length(Dir),1);
   Trova_File_Recente:=Dir+ActFile;
end;

Function InitNodeList(DirName:String):Boolean;
Var
   C:Boolean;
   S:SearchRec;

Begin
   If (DirName[Length(DirName)]<>'\') and (Length(DirName)>0) then
      DirName:=DirName+'\';
   DirName:=FExpand(DirName);
   Assign(NodeLocFile,DirName+'nodeloc.wnl');
   Assign(SysopListFile,DirName+'syslist.wnl');
   Assign(NodeIdxFile,DirName+'nodeidx.wnl');
   C:=True;
   Assign(Nodelist1,Trova_File_Recente(DirName+'NODELIST.*',C));
   Assign(Nodelist2,DirName+'ALTNODE.WNL');
   InitNodeList:=FileExists(DirName+'syslist.wnl') and
                 FileExists(DirName+'nodeidx.wnl') and
                 FileExists(DirName+'nodeloc.wnl');
   S.Name:='';
   FindFirst(DirName+'NODELOC.WNL',Archive,S);
   If S.Name<>'' then
      NodeTime:=S.Time
   else
      NodeTime:=0;
end;

Procedure CloseNodeListFiles;
Begin
   If FileRec(NodeLocFile).Mode=FMInOut then
      Close(NodeLocFile);
   If FileRec(SysopListFile).Mode=FMInOut then
      Close(SysopListFile);
   If FileRec(NodeIdxFile).Mode=FMInOut then
      Close(NodeIdxFile);
   If FileRec(NodeList1).Mode=FMInOut then
      Close(NodeList1);
   If FileRec(NodeList2).Mode=FMInOut then
      Close(NodeList2);
end;

Begin
end.